home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / generic / tkText.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  67.6 KB  |  2,265 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkText.c --
  3.  *
  4.  *    This module provides a big chunk of the implementation of
  5.  *    multi-line editable text widgets for Tk.  Among other things,
  6.  *    it provides the Tcl command interfaces to text widgets and
  7.  *    the display code.  The B-tree representation of text is
  8.  *    implemented elsewhere.
  9.  *
  10.  * Copyright (c) 1992-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  *
  16.  * SCCS: @(#) tkText.c 1.103 97/07/31 09:14:37
  17.  */
  18.  
  19. #include "default.h"
  20. #include "tkPort.h"
  21. #include "tkInt.h"
  22.  
  23. #ifdef MAC_TCL
  24. #define Style TkStyle
  25. #define DInfo TkDInfo
  26. #endif
  27.  
  28. #include "tkText.h"
  29.  
  30. /*
  31.  * Information used to parse text configuration options:
  32.  */
  33.  
  34. static Tk_ConfigSpec configSpecs[] = {
  35.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  36.     DEF_TEXT_BG_COLOR, Tk_Offset(TkText, border), TK_CONFIG_COLOR_ONLY},
  37.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  38.     DEF_TEXT_BG_MONO, Tk_Offset(TkText, border), TK_CONFIG_MONO_ONLY},
  39.     {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
  40.     (char *) NULL, 0, 0},
  41.     {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
  42.     (char *) NULL, 0, 0},
  43.     {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
  44.     DEF_TEXT_BORDER_WIDTH, Tk_Offset(TkText, borderWidth), 0},
  45.     {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
  46.     DEF_TEXT_CURSOR, Tk_Offset(TkText, cursor), TK_CONFIG_NULL_OK},
  47.     {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
  48.     "ExportSelection", DEF_TEXT_EXPORT_SELECTION,
  49.     Tk_Offset(TkText, exportSelection), 0},
  50.     {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
  51.     (char *) NULL, 0, 0},
  52.     {TK_CONFIG_FONT, "-font", "font", "Font",
  53.     DEF_TEXT_FONT, Tk_Offset(TkText, tkfont), 0},
  54.     {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
  55.     DEF_TEXT_FG, Tk_Offset(TkText, fgColor), 0},
  56.     {TK_CONFIG_PIXELS, "-height", "height", "Height",
  57.     DEF_TEXT_HEIGHT, Tk_Offset(TkText, height), 0},
  58.     {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
  59.     "HighlightBackground", DEF_TEXT_HIGHLIGHT_BG,
  60.     Tk_Offset(TkText, highlightBgColorPtr), 0},
  61.     {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
  62.     DEF_TEXT_HIGHLIGHT, Tk_Offset(TkText, highlightColorPtr), 0},
  63.     {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
  64.     "HighlightThickness",
  65.     DEF_TEXT_HIGHLIGHT_WIDTH, Tk_Offset(TkText, highlightWidth), 0},
  66.     {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
  67.     DEF_TEXT_INSERT_BG, Tk_Offset(TkText, insertBorder), 0},
  68.     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
  69.     DEF_TEXT_INSERT_BD_COLOR, Tk_Offset(TkText, insertBorderWidth),
  70.     TK_CONFIG_COLOR_ONLY},
  71.     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
  72.     DEF_TEXT_INSERT_BD_MONO, Tk_Offset(TkText, insertBorderWidth),
  73.     TK_CONFIG_MONO_ONLY},
  74.     {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
  75.     DEF_TEXT_INSERT_OFF_TIME, Tk_Offset(TkText, insertOffTime), 0},
  76.     {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
  77.     DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0},
  78.     {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
  79.     DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0},
  80.     {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
  81.     DEF_TEXT_PADX, Tk_Offset(TkText, padX), 0},
  82.     {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
  83.     DEF_TEXT_PADY, Tk_Offset(TkText, padY), 0},
  84.     {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
  85.     DEF_TEXT_RELIEF, Tk_Offset(TkText, relief), 0},
  86.     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
  87.     DEF_TEXT_SELECT_COLOR, Tk_Offset(TkText, selBorder),
  88.     TK_CONFIG_COLOR_ONLY},
  89.     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
  90.     DEF_TEXT_SELECT_MONO, Tk_Offset(TkText, selBorder),
  91.     TK_CONFIG_MONO_ONLY},
  92.     {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
  93.     DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBdString),
  94.     TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
  95.     {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
  96.     DEF_TEXT_SELECT_BD_MONO, Tk_Offset(TkText, selBdString),
  97.     TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
  98.     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
  99.     DEF_TEXT_SELECT_FG_COLOR, Tk_Offset(TkText, selFgColorPtr),
  100.     TK_CONFIG_COLOR_ONLY},
  101.     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
  102.     DEF_TEXT_SELECT_FG_MONO, Tk_Offset(TkText, selFgColorPtr),
  103.     TK_CONFIG_MONO_ONLY},
  104.     {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
  105.     DEF_TEXT_SET_GRID, Tk_Offset(TkText, setGrid), 0},
  106.     {TK_CONFIG_PIXELS, "-spacing1", "spacing1", "Spacing",
  107.     DEF_TEXT_SPACING1, Tk_Offset(TkText, spacing1),
  108.     TK_CONFIG_DONT_SET_DEFAULT},
  109.     {TK_CONFIG_PIXELS, "-spacing2", "spacing2", "Spacing",
  110.     DEF_TEXT_SPACING2, Tk_Offset(TkText, spacing2),
  111.     TK_CONFIG_DONT_SET_DEFAULT},
  112.     {TK_CONFIG_PIXELS, "-spacing3", "spacing3", "Spacing",
  113.     DEF_TEXT_SPACING3, Tk_Offset(TkText, spacing3),
  114.     TK_CONFIG_DONT_SET_DEFAULT},
  115.     {TK_CONFIG_UID, "-state", "state", "State",
  116.     DEF_TEXT_STATE, Tk_Offset(TkText, state), 0},
  117.     {TK_CONFIG_STRING, "-tabs", "tabs", "Tabs",
  118.     DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionString), TK_CONFIG_NULL_OK},
  119.     {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
  120.     DEF_TEXT_TAKE_FOCUS, Tk_Offset(TkText, takeFocus),
  121.     TK_CONFIG_NULL_OK},
  122.     {TK_CONFIG_INT, "-width", "width", "Width",
  123.     DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
  124.     {TK_CONFIG_UID, "-wrap", "wrap", "Wrap",
  125.     DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0},
  126.     {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
  127.     DEF_TEXT_XSCROLL_COMMAND, Tk_Offset(TkText, xScrollCmd),
  128.     TK_CONFIG_NULL_OK},
  129.     {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
  130.     DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
  131.     TK_CONFIG_NULL_OK},
  132.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  133.     (char *) NULL, 0, 0}
  134. };
  135.  
  136. /*
  137.  * Tk_Uid's used to represent text states:
  138.  */
  139.  
  140. Tk_Uid tkTextCharUid = NULL;
  141. Tk_Uid tkTextDisabledUid = NULL;
  142. Tk_Uid tkTextNoneUid = NULL;
  143. Tk_Uid tkTextNormalUid = NULL;
  144. Tk_Uid tkTextWordUid = NULL;
  145.  
  146. /*
  147.  * Boolean variable indicating whether or not special debugging code
  148.  * should be executed.
  149.  */
  150.  
  151. int tkTextDebug = 0;
  152.  
  153. /*
  154.  * Forward declarations for procedures defined later in this file:
  155.  */
  156.  
  157. static int        ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
  158.                 TkText *textPtr, int argc, char **argv, int flags));
  159. static int        DeleteChars _ANSI_ARGS_((TkText *textPtr,
  160.                 char *index1String, char *index2String));
  161. static void        DestroyText _ANSI_ARGS_((char *memPtr));
  162. static void        InsertChars _ANSI_ARGS_((TkText *textPtr,
  163.                 TkTextIndex *indexPtr, char *string));
  164. static void        TextBlinkProc _ANSI_ARGS_((ClientData clientData));
  165. static void        TextCmdDeletedProc _ANSI_ARGS_((
  166.                 ClientData clientData));
  167. static void        TextEventProc _ANSI_ARGS_((ClientData clientData,
  168.                 XEvent *eventPtr));
  169. static int        TextFetchSelection _ANSI_ARGS_((ClientData clientData,
  170.                 int offset, char *buffer, int maxBytes));
  171. static int        TextSearchCmd _ANSI_ARGS_((TkText *textPtr,
  172.                 Tcl_Interp *interp, int argc, char **argv));
  173. static int        TextWidgetCmd _ANSI_ARGS_((ClientData clientData,
  174.                 Tcl_Interp *interp, int argc, char **argv));
  175. static void        TextWorldChanged _ANSI_ARGS_((
  176.                 ClientData instanceData));
  177. static int        TextDumpCmd _ANSI_ARGS_((TkText *textPtr,
  178.                 Tcl_Interp *interp, int argc, char **argv));
  179. static void        DumpLine _ANSI_ARGS_((Tcl_Interp *interp, 
  180.                 TkText *textPtr, int what, TkTextLine *linePtr,
  181.                 int start, int end, int lineno, char *command));
  182. static int        DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key,
  183.                 char *value, char * command, int lineno, int offset,
  184.                 int what));
  185.  
  186. /*
  187.  * The structure below defines text class behavior by means of procedures
  188.  * that can be invoked from generic window code.
  189.  */
  190.  
  191. static TkClassProcs textClass = {
  192.     NULL,            /* createProc. */
  193.     TextWorldChanged,        /* geometryProc. */
  194.     NULL            /* modalProc. */
  195. };
  196.  
  197.  
  198. /*
  199.  *--------------------------------------------------------------
  200.  *
  201.  * Tk_TextCmd --
  202.  *
  203.  *    This procedure is invoked to process the "text" Tcl command.
  204.  *    See the user documentation for details on what it does.
  205.  *
  206.  * Results:
  207.  *    A standard Tcl result.
  208.  *
  209.  * Side effects:
  210.  *    See the user documentation.
  211.  *
  212.  *--------------------------------------------------------------
  213.  */
  214.  
  215. int
  216. Tk_TextCmd(clientData, interp, argc, argv)
  217.     ClientData clientData;    /* Main window associated with
  218.                  * interpreter. */
  219.     Tcl_Interp *interp;        /* Current interpreter. */
  220.     int argc;            /* Number of arguments. */
  221.     char **argv;        /* Argument strings. */
  222. {
  223.     Tk_Window tkwin = (Tk_Window) clientData;
  224.     Tk_Window new;
  225.     register TkText *textPtr;
  226.     TkTextIndex startIndex;
  227.  
  228.     if (argc < 2) {
  229.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  230.         argv[0], " pathName ?options?\"", (char *) NULL);
  231.     return TCL_ERROR;
  232.     }
  233.  
  234.     /*
  235.      * Perform once-only initialization:
  236.      */
  237.  
  238.     if (tkTextNormalUid == NULL) {
  239.     tkTextCharUid = Tk_GetUid("char");
  240.     tkTextDisabledUid = Tk_GetUid("disabled");
  241.     tkTextNoneUid = Tk_GetUid("none");
  242.     tkTextNormalUid = Tk_GetUid("normal");
  243.     tkTextWordUid = Tk_GetUid("word");
  244.     }
  245.  
  246.     /*
  247.      * Create the window.
  248.      */
  249.  
  250.     new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
  251.     if (new == NULL) {
  252.     return TCL_ERROR;
  253.     }
  254.  
  255.     textPtr = (TkText *) ckalloc(sizeof(TkText));
  256.     textPtr->tkwin = new;
  257.     textPtr->display = Tk_Display(new);
  258.     textPtr->interp = interp;
  259.     textPtr->widgetCmd = Tcl_CreateCommand(interp,
  260.         Tk_PathName(textPtr->tkwin), TextWidgetCmd,
  261.         (ClientData) textPtr, TextCmdDeletedProc);
  262.     textPtr->tree = TkBTreeCreate(textPtr);
  263.     Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS);
  264.     textPtr->numTags = 0;
  265.     Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
  266.     Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
  267.     Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS);
  268.     textPtr->state = tkTextNormalUid;
  269.     textPtr->border = NULL;
  270.     textPtr->borderWidth = 0;
  271.     textPtr->padX = 0;
  272.     textPtr->padY = 0;
  273.     textPtr->relief = TK_RELIEF_FLAT;
  274.     textPtr->highlightWidth = 0;
  275.     textPtr->highlightBgColorPtr = NULL;
  276.     textPtr->highlightColorPtr = NULL;
  277.     textPtr->cursor = None;
  278.     textPtr->fgColor = NULL;
  279.     textPtr->tkfont = NULL;
  280.     textPtr->charWidth = 1;
  281.     textPtr->spacing1 = 0;
  282.     textPtr->spacing2 = 0;
  283.     textPtr->spacing3 = 0;
  284.     textPtr->tabOptionString = NULL;
  285.     textPtr->tabArrayPtr = NULL;
  286.     textPtr->wrapMode = tkTextCharUid;
  287.     textPtr->width = 0;
  288.     textPtr->height = 0;
  289.     textPtr->setGrid = 0;
  290.     textPtr->prevWidth = Tk_Width(new);
  291.     textPtr->prevHeight = Tk_Height(new);
  292.     TkTextCreateDInfo(textPtr);
  293.     TkTextMakeIndex(textPtr->tree, 0, 0, &startIndex);
  294.     TkTextSetYView(textPtr, &startIndex, 0);
  295.     textPtr->selTagPtr = NULL;
  296.     textPtr->selBorder = NULL;
  297.     textPtr->selBdString = NULL;
  298.     textPtr->selFgColorPtr = NULL;
  299.     textPtr->exportSelection = 1;
  300.     textPtr->abortSelections = 0;
  301.     textPtr->insertMarkPtr = NULL;
  302.     textPtr->insertBorder = NULL;
  303.     textPtr->insertWidth = 0;
  304.     textPtr->insertBorderWidth = 0;
  305.     textPtr->insertOnTime = 0;
  306.     textPtr->insertOffTime = 0;
  307.     textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
  308.     textPtr->bindingTable = NULL;
  309.     textPtr->currentMarkPtr = NULL;
  310.     textPtr->pickEvent.type = LeaveNotify;
  311.     textPtr->pickEvent.xcrossing.x = 0;
  312.     textPtr->pickEvent.xcrossing.y = 0;
  313.     textPtr->numCurTags = 0;
  314.     textPtr->curTagArrayPtr = NULL;
  315.     textPtr->takeFocus = NULL;
  316.     textPtr->xScrollCmd = NULL;
  317.     textPtr->yScrollCmd = NULL;
  318.     textPtr->flags = 0;
  319.  
  320.     /*
  321.      * Create the "sel" tag and the "current" and "insert" marks.
  322.      */
  323.  
  324.     textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
  325.     textPtr->selTagPtr->reliefString = (char *) ckalloc(7);
  326.     strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF);
  327.     textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
  328.     textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
  329.     textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);
  330.  
  331.     Tk_SetClass(textPtr->tkwin, "Text");
  332.     TkSetClassProcs(textPtr->tkwin, &textClass, (ClientData) textPtr);
  333.     Tk_CreateEventHandler(textPtr->tkwin,
  334.         ExposureMask|StructureNotifyMask|FocusChangeMask,
  335.         TextEventProc, (ClientData) textPtr);
  336.     Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
  337.         |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
  338.         |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
  339.         TkTextBindProc, (ClientData) textPtr);
  340.     Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
  341.         TextFetchSelection, (ClientData) textPtr, XA_STRING);
  342.     if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
  343.     Tk_DestroyWindow(textPtr->tkwin);
  344.     return TCL_ERROR;
  345.     }
  346.     interp->result = Tk_PathName(textPtr->tkwin);
  347.  
  348.     return TCL_OK;
  349. }
  350.  
  351. /*
  352.  *--------------------------------------------------------------
  353.  *
  354.  * TextWidgetCmd --
  355.  *
  356.  *    This procedure is invoked to process the Tcl command
  357.  *    that corresponds to a text widget.  See the user
  358.  *    documentation for details on what it does.
  359.  *
  360.  * Results:
  361.  *    A standard Tcl result.
  362.  *
  363.  * Side effects:
  364.  *    See the user documentation.
  365.  *
  366.  *--------------------------------------------------------------
  367.  */
  368.  
  369. static int
  370. TextWidgetCmd(clientData, interp, argc, argv)
  371.     ClientData clientData;    /* Information about text widget. */
  372.     Tcl_Interp *interp;        /* Current interpreter. */
  373.     int argc;            /* Number of arguments. */
  374.     char **argv;        /* Argument strings. */
  375. {
  376.     register TkText *textPtr = (TkText *) clientData;
  377.     int result = TCL_OK;
  378.     size_t length;
  379.     int c;
  380.     TkTextIndex index1, index2;
  381.  
  382.     if (argc < 2) {
  383.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  384.         argv[0], " option ?arg arg ...?\"", (char *) NULL);
  385.     return TCL_ERROR;
  386.     }
  387.     Tcl_Preserve((ClientData) textPtr);
  388.     c = argv[1][0];
  389.     length = strlen(argv[1]);
  390.     if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
  391.     int x, y, width, height;
  392.  
  393.     if (argc != 3) {
  394.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  395.             argv[0], " bbox index\"", (char *) NULL);
  396.         result = TCL_ERROR;
  397.         goto done;
  398.     }
  399.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  400.         result = TCL_ERROR;
  401.         goto done;
  402.     }
  403.     if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) {
  404.         sprintf(interp->result, "%d %d %d %d", x, y, width, height);
  405.     }
  406.     } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
  407.         && (length >= 2)) {
  408.     if (argc != 3) {
  409.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  410.             argv[0], " cget option\"",
  411.             (char *) NULL);
  412.         result = TCL_ERROR;
  413.         goto done;
  414.     }
  415.     result = Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
  416.         (char *) textPtr, argv[2], 0);
  417.     } else if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)
  418.         && (length >= 3)) {
  419.     int relation, value;
  420.     char *p;
  421.  
  422.     if (argc != 5) {
  423.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  424.             argv[0], " compare index1 op index2\"", (char *) NULL);
  425.         result = TCL_ERROR;
  426.         goto done;
  427.     }
  428.     if ((TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK)
  429.         || (TkTextGetIndex(interp, textPtr, argv[4], &index2)
  430.         != TCL_OK)) {
  431.         result = TCL_ERROR;
  432.         goto done;
  433.     }
  434.     relation = TkTextIndexCmp(&index1, &index2);
  435.     p = argv[3];
  436.     if (p[0] == '<') {
  437.         value = (relation < 0);
  438.         if ((p[1] == '=') && (p[2] == 0)) {
  439.         value = (relation <= 0);
  440.         } else if (p[1] != 0) {
  441.         compareError:
  442.         Tcl_AppendResult(interp, "bad comparison operator \"",
  443.             argv[3], "\": must be <, <=, ==, >=, >, or !=",
  444.             (char *) NULL);
  445.         result = TCL_ERROR;
  446.         goto done;
  447.         }
  448.     } else if (p[0] == '>') {
  449.         value = (relation > 0);
  450.         if ((p[1] == '=') && (p[2] == 0)) {
  451.         value = (relation >= 0);
  452.         } else if (p[1] != 0) {
  453.         goto compareError;
  454.         }
  455.     } else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
  456.         value = (relation == 0);
  457.     } else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
  458.         value = (relation != 0);
  459.     } else {
  460.         goto compareError;
  461.     }
  462.     interp->result = (value) ? "1" : "0";
  463.     } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
  464.         && (length >= 3)) {
  465.     if (argc == 2) {
  466.         result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
  467.             (char *) textPtr, (char *) NULL, 0);
  468.     } else if (argc == 3) {
  469.         result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
  470.             (char *) textPtr, argv[2], 0);
  471.     } else {
  472.         result = ConfigureText(interp, textPtr, argc-2, argv+2,
  473.             TK_CONFIG_ARGV_ONLY);
  474.     }
  475.     } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0)
  476.         && (length >= 3)) {
  477.     if (argc > 3) {
  478.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  479.             argv[0], " debug boolean\"", (char *) NULL);
  480.         result = TCL_ERROR;
  481.         goto done;
  482.     }
  483.     if (argc == 2) {
  484.         interp->result = (tkBTreeDebug) ? "1" : "0";
  485.     } else {
  486.         if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
  487.         result = TCL_ERROR;
  488.         goto done;
  489.         }
  490.         tkTextDebug = tkBTreeDebug;
  491.     }
  492.     } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
  493.         && (length >= 3)) {
  494.     if ((argc != 3) && (argc != 4)) {
  495.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  496.             argv[0], " delete index1 ?index2?\"", (char *) NULL);
  497.         result = TCL_ERROR;
  498.         goto done;
  499.     }
  500.     if (textPtr->state == tkTextNormalUid) {
  501.         result = DeleteChars(textPtr, argv[2],
  502.             (argc == 4) ? argv[3] : (char *) NULL);
  503.     }
  504.     } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0)
  505.         && (length >= 2)) {
  506.     int x, y, width, height, base;
  507.  
  508.     if (argc != 3) {
  509.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  510.             argv[0], " dlineinfo index\"", (char *) NULL);
  511.         result = TCL_ERROR;
  512.         goto done;
  513.     }
  514.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  515.         result = TCL_ERROR;
  516.         goto done;
  517.     }
  518.     if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
  519.         == 0) {
  520.         sprintf(interp->result, "%d %d %d %d %d", x, y, width,
  521.             height, base);
  522.     }
  523.     } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
  524.     if ((argc != 3) && (argc != 4)) {
  525.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  526.             argv[0], " get index1 ?index2?\"", (char *) NULL);
  527.         result = TCL_ERROR;
  528.         goto done;
  529.     }
  530.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  531.         result = TCL_ERROR;
  532.         goto done;
  533.     }
  534.     if (argc == 3) {
  535.         index2 = index1;
  536.         TkTextIndexForwChars(&index2, 1, &index2);
  537.     } else if (TkTextGetIndex(interp, textPtr, argv[3], &index2)
  538.         != TCL_OK) {
  539.         result = TCL_ERROR;
  540.         goto done;
  541.     }
  542.     if (TkTextIndexCmp(&index1, &index2) >= 0) {
  543.         goto done;
  544.     }
  545.     while (1) {
  546.         int offset, last, savedChar;
  547.         TkTextSegment *segPtr;
  548.  
  549.         segPtr = TkTextIndexToSeg(&index1, &offset);
  550.         last = segPtr->size;
  551.         if (index1.linePtr == index2.linePtr) {
  552.         int last2;
  553.  
  554.         if (index2.charIndex == index1.charIndex) {
  555.             break;
  556.         }
  557.         last2 = index2.charIndex - index1.charIndex + offset;
  558.         if (last2 < last) {
  559.             last = last2;
  560.         }
  561.         }
  562.         if (segPtr->typePtr == &tkTextCharType) {
  563.         savedChar = segPtr->body.chars[last];
  564.         segPtr->body.chars[last] = 0;
  565.         Tcl_AppendResult(interp, segPtr->body.chars + offset,
  566.             (char *) NULL);
  567.         segPtr->body.chars[last] = savedChar;
  568.         }
  569.         TkTextIndexForwChars(&index1, last-offset, &index1);
  570.     }
  571.     } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
  572.         && (length >= 3)) {
  573.     if (argc != 3) {
  574.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  575.             argv[0], " index index\"",
  576.             (char *) NULL);
  577.         result = TCL_ERROR;
  578.         goto done;
  579.     }
  580.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  581.         result = TCL_ERROR;
  582.         goto done;
  583.     }
  584.     TkTextPrintIndex(&index1, interp->result);
  585.     } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
  586.         && (length >= 3)) {
  587.     int i, j, numTags;
  588.     char **tagNames;
  589.     TkTextTag **oldTagArrayPtr;
  590.  
  591.     if (argc < 4) {
  592.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  593.             argv[0],
  594.             " insert index chars ?tagList chars tagList ...?\"",
  595.             (char *) NULL);
  596.         result = TCL_ERROR;
  597.         goto done;
  598.     }
  599.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  600.         result = TCL_ERROR;
  601.         goto done;
  602.     }
  603.     if (textPtr->state == tkTextNormalUid) {
  604.         for (j = 3;  j < argc; j += 2) {
  605.         InsertChars(textPtr, &index1, argv[j]);
  606.         if (argc > (j+1)) {
  607.             TkTextIndexForwChars(&index1, (int) strlen(argv[j]),
  608.                 &index2);
  609.             oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
  610.             if (oldTagArrayPtr != NULL) {
  611.             for (i = 0; i < numTags; i++) {
  612.                 TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
  613.             }
  614.             ckfree((char *) oldTagArrayPtr);
  615.             }
  616.             if (Tcl_SplitList(interp, argv[j+1], &numTags, &tagNames)
  617.                 != TCL_OK) {
  618.             result = TCL_ERROR;
  619.             goto done;
  620.             }
  621.             for (i = 0; i < numTags; i++) {
  622.             TkBTreeTag(&index1, &index2,
  623.                 TkTextCreateTag(textPtr, tagNames[i]), 1);
  624.             }
  625.             ckfree((char *) tagNames);
  626.             index1 = index2;
  627.         }
  628.         }
  629.     }
  630.     } else if ((c == 'd') && (strncmp(argv[1], "dump", length) == 0)) {
  631.     result = TextDumpCmd(textPtr, interp, argc, argv);
  632.     } else if ((c == 'i') && (strncmp(argv[1], "image", length) == 0)) {
  633.     result = TkTextImageCmd(textPtr, interp, argc, argv);
  634.     } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) {
  635.     result = TkTextMarkCmd(textPtr, interp, argc, argv);
  636.     } else if ((c == 's') && (strcmp(argv[1], "scan") == 0) && (length >= 2)) {
  637.     result = TkTextScanCmd(textPtr, interp, argc, argv);
  638.     } else if ((c == 's') && (strcmp(argv[1], "search") == 0)
  639.         && (length >= 3)) {
  640.     result = TextSearchCmd(textPtr, interp, argc, argv);
  641.     } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) {
  642.     result = TkTextSeeCmd(textPtr, interp, argc, argv);
  643.     } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) {
  644.     result = TkTextTagCmd(textPtr, interp, argc, argv);
  645.     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
  646.     result = TkTextWindowCmd(textPtr, interp, argc, argv);
  647.     } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
  648.     result = TkTextXviewCmd(textPtr, interp, argc, argv);
  649.     } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)
  650.         && (length >= 2)) {
  651.     result = TkTextYviewCmd(textPtr, interp, argc, argv);
  652.     } else {
  653.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  654.         "\": must be bbox, cget, compare, configure, debug, delete, ",
  655.         "dlineinfo, get, image, index, insert, mark, scan, search, see, ",
  656.         "tag, window, xview, or yview",
  657.         (char *) NULL);
  658.     result = TCL_ERROR;
  659.     }
  660.  
  661.     done:
  662.     Tcl_Release((ClientData) textPtr);
  663.     return result;
  664. }
  665.  
  666. /*
  667.  *----------------------------------------------------------------------
  668.  *
  669.  * DestroyText --
  670.  *
  671.  *    This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
  672.  *    to clean up the internal structure of a text at a safe time
  673.  *    (when no-one is using it anymore).
  674.  *
  675.  * Results:
  676.  *    None.
  677.  *
  678.  * Side effects:
  679.  *    Everything associated with the text is freed up.
  680.  *
  681.  *----------------------------------------------------------------------
  682.  */
  683.  
  684. static void
  685. DestroyText(memPtr)
  686.     char *memPtr;        /* Info about text widget. */
  687. {
  688.     register TkText *textPtr = (TkText *) memPtr;
  689.     Tcl_HashSearch search;
  690.     Tcl_HashEntry *hPtr;
  691.     TkTextTag *tagPtr;
  692.  
  693.     /*
  694.      * Free up all the stuff that requires special handling, then
  695.      * let Tk_FreeOptions handle all the standard option-related
  696.      * stuff.  Special note:  free up display-related information
  697.      * before deleting the B-tree, since display-related stuff
  698.      * may refer to stuff in the B-tree.
  699.      */
  700.  
  701.     TkTextFreeDInfo(textPtr);
  702.     TkBTreeDestroy(textPtr->tree);
  703.     for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
  704.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  705.     tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
  706.     TkTextFreeTag(textPtr, tagPtr);
  707.     }
  708.     Tcl_DeleteHashTable(&textPtr->tagTable);
  709.     for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
  710.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  711.     ckfree((char *) Tcl_GetHashValue(hPtr));
  712.     }
  713.     Tcl_DeleteHashTable(&textPtr->markTable);
  714.     if (textPtr->tabArrayPtr != NULL) {
  715.     ckfree((char *) textPtr->tabArrayPtr);
  716.     }
  717.     if (textPtr->insertBlinkHandler != NULL) {
  718.     Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
  719.     }
  720.     if (textPtr->bindingTable != NULL) {
  721.     Tk_DeleteBindingTable(textPtr->bindingTable);
  722.     }
  723.  
  724.     /*
  725.      * NOTE: do NOT free up selBorder, selBdString, or selFgColorPtr:
  726.      * they are duplicates of information in the "sel" tag, which was
  727.      * freed up as part of deleting the tags above.
  728.      */
  729.  
  730.     textPtr->selBorder = NULL;
  731.     textPtr->selBdString = NULL;
  732.     textPtr->selFgColorPtr = NULL;
  733.     Tk_FreeOptions(configSpecs, (char *) textPtr, textPtr->display, 0);
  734.     ckfree((char *) textPtr);
  735. }
  736.  
  737. /*
  738.  *----------------------------------------------------------------------
  739.  *
  740.  * ConfigureText --
  741.  *
  742.  *    This procedure is called to process an argv/argc list, plus
  743.  *    the Tk option database, in order to configure (or
  744.  *    reconfigure) a text widget.
  745.  *
  746.  * Results:
  747.  *    The return value is a standard Tcl result.  If TCL_ERROR is
  748.  *    returned, then interp->result contains an error message.
  749.  *
  750.  * Side effects:
  751.  *    Configuration information, such as text string, colors, font,
  752.  *    etc. get set for textPtr;  old resources get freed, if there
  753.  *    were any.
  754.  *
  755.  *----------------------------------------------------------------------
  756.  */
  757.  
  758. static int
  759. ConfigureText(interp, textPtr, argc, argv, flags)
  760.     Tcl_Interp *interp;        /* Used for error reporting. */
  761.     register TkText *textPtr;    /* Information about widget;  may or may
  762.                  * not already have values for some fields. */
  763.     int argc;            /* Number of valid entries in argv. */
  764.     char **argv;        /* Arguments. */
  765.     int flags;            /* Flags to pass to Tk_ConfigureWidget. */
  766. {
  767.     int oldExport = textPtr->exportSelection;
  768.  
  769.     if (Tk_ConfigureWidget(interp, textPtr->tkwin, configSpecs,
  770.         argc, argv, (char *) textPtr, flags) != TCL_OK) {
  771.     return TCL_ERROR;
  772.     }
  773.  
  774.     /*
  775.      * A few other options also need special processing, such as parsing
  776.      * the geometry and setting the background from a 3-D border.
  777.      */
  778.  
  779.     if ((textPtr->state != tkTextNormalUid)
  780.         && (textPtr->state != tkTextDisabledUid)) {
  781.     Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
  782.         "\": must be normal or disabled", (char *) NULL);
  783.     textPtr->state = tkTextNormalUid;
  784.     return TCL_ERROR;
  785.     }
  786.  
  787.     if ((textPtr->wrapMode != tkTextCharUid)
  788.         && (textPtr->wrapMode != tkTextNoneUid)
  789.         && (textPtr->wrapMode != tkTextWordUid)) {
  790.     Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode,
  791.         "\": must be char, none, or word", (char *) NULL);
  792.     textPtr->wrapMode = tkTextCharUid;
  793.     return TCL_ERROR;
  794.     }
  795.  
  796.     Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);
  797.  
  798.     /*
  799.      * Don't allow negative spacings.
  800.      */
  801.  
  802.     if (textPtr->spacing1 < 0) {
  803.     textPtr->spacing1 = 0;
  804.     }
  805.     if (textPtr->spacing2 < 0) {
  806.     textPtr->spacing2 = 0;
  807.     }
  808.     if (textPtr->spacing3 < 0) {
  809.     textPtr->spacing3 = 0;
  810.     }
  811.  
  812.     /*
  813.      * Parse tab stops.
  814.      */
  815.  
  816.     if (textPtr->tabArrayPtr != NULL) {
  817.     ckfree((char *) textPtr->tabArrayPtr);
  818.     textPtr->tabArrayPtr = NULL;
  819.     }
  820.     if (textPtr->tabOptionString != NULL) {
  821.     textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin,
  822.         textPtr->tabOptionString);
  823.     if (textPtr->tabArrayPtr == NULL) {
  824.         Tcl_AddErrorInfo(interp,"\n    (while processing -tabs option)");
  825.         return TCL_ERROR;
  826.     }
  827.     }
  828.  
  829.     /*
  830.      * Make sure that configuration options are properly mirrored
  831.      * between the widget record and the "sel" tags.  NOTE: we don't
  832.      * have to free up information during the mirroring;  old
  833.      * information was freed when it was replaced in the widget
  834.      * record.
  835.      */
  836.  
  837.     textPtr->selTagPtr->border = textPtr->selBorder;
  838.     if (textPtr->selTagPtr->bdString != textPtr->selBdString) {
  839.     textPtr->selTagPtr->bdString = textPtr->selBdString;
  840.     if (textPtr->selBdString != NULL) {
  841.         if (Tk_GetPixels(interp, textPtr->tkwin, textPtr->selBdString,
  842.             &textPtr->selTagPtr->borderWidth) != TCL_OK) {
  843.         return TCL_ERROR;
  844.         }
  845.         if (textPtr->selTagPtr->borderWidth < 0) {
  846.         textPtr->selTagPtr->borderWidth = 0;
  847.         }
  848.     }
  849.     }
  850.     textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
  851.     textPtr->selTagPtr->affectsDisplay = 0;
  852.     if ((textPtr->selTagPtr->border != NULL)
  853.         || (textPtr->selTagPtr->bdString != NULL)
  854.         || (textPtr->selTagPtr->reliefString != NULL)
  855.         || (textPtr->selTagPtr->bgStipple != None)
  856.         || (textPtr->selTagPtr->fgColor != NULL)
  857.         || (textPtr->selTagPtr->tkfont != None)
  858.         || (textPtr->selTagPtr->fgStipple != None)
  859.         || (textPtr->selTagPtr->justifyString != NULL)
  860.         || (textPtr->selTagPtr->lMargin1String != NULL)
  861.         || (textPtr->selTagPtr->lMargin2String != NULL)
  862.         || (textPtr->selTagPtr->offsetString != NULL)
  863.         || (textPtr->selTagPtr->overstrikeString != NULL)
  864.         || (textPtr->selTagPtr->rMarginString != NULL)
  865.         || (textPtr->selTagPtr->spacing1String != NULL)
  866.         || (textPtr->selTagPtr->spacing2String != NULL)
  867.         || (textPtr->selTagPtr->spacing3String != NULL)
  868.         || (textPtr->selTagPtr->tabString != NULL)
  869.         || (textPtr->selTagPtr->underlineString != NULL)
  870.         || (textPtr->selTagPtr->wrapMode != NULL)) {
  871.     textPtr->selTagPtr->affectsDisplay = 1;
  872.     }
  873.     TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
  874.         textPtr->selTagPtr, 1);
  875.  
  876.     /*
  877.      * Claim the selection if we've suddenly started exporting it and there
  878.      * are tagged characters.
  879.      */
  880.  
  881.     if (textPtr->exportSelection && (!oldExport)) {
  882.     TkTextSearch search;
  883.     TkTextIndex first, last;
  884.  
  885.     TkTextMakeIndex(textPtr->tree, 0, 0, &first);
  886.     TkTextMakeIndex(textPtr->tree,
  887.         TkBTreeNumLines(textPtr->tree), 0, &last);
  888.     TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
  889.     if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
  890.         || TkBTreeNextTag(&search)) {
  891.         Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
  892.             (ClientData) textPtr);
  893.         textPtr->flags |= GOT_SELECTION;
  894.     }
  895.     }
  896.  
  897.     /*
  898.      * Register the desired geometry for the window, and arrange for
  899.      * the window to be redisplayed.
  900.      */
  901.  
  902.     if (textPtr->width <= 0) {
  903.     textPtr->width = 1;
  904.     }
  905.     if (textPtr->height <= 0) {
  906.     textPtr->height = 1;
  907.     }
  908.     TextWorldChanged((ClientData) textPtr);
  909.     return TCL_OK;
  910. }
  911.  
  912. /*
  913.  *---------------------------------------------------------------------------
  914.  *
  915.  * TextWorldChanged --
  916.  *
  917.  *      This procedure is called when the world has changed in some
  918.  *      way and the widget needs to recompute all its graphics contexts
  919.  *    and determine its new geometry.
  920.  *
  921.  * Results:
  922.  *      None.
  923.  *
  924.  * Side effects:
  925.  *    Configures all tags in the Text with a empty argc/argv, for
  926.  *    the side effect of causing all the items to recompute their
  927.  *    geometry and to be redisplayed.
  928.  *
  929.  *---------------------------------------------------------------------------
  930.  */
  931.  
  932. static void
  933. TextWorldChanged(instanceData)
  934.     ClientData instanceData;    /* Information about widget. */
  935. {
  936.     TkText *textPtr;
  937.     Tk_FontMetrics fm;
  938.  
  939.     textPtr = (TkText *) instanceData;
  940.  
  941.     textPtr->charWidth = Tk_TextWidth(textPtr->tkfont, "0", 1);
  942.     if (textPtr->charWidth <= 0) {
  943.     textPtr->charWidth = 1;
  944.     }
  945.     Tk_GetFontMetrics(textPtr->tkfont, &fm);
  946.     Tk_GeometryRequest(textPtr->tkwin,
  947.         textPtr->width * textPtr->charWidth + 2*textPtr->borderWidth
  948.             + 2*textPtr->padX + 2*textPtr->highlightWidth,
  949.         textPtr->height * (fm.linespace + textPtr->spacing1
  950.             + textPtr->spacing3) + 2*textPtr->borderWidth
  951.             + 2*textPtr->padY + 2*textPtr->highlightWidth);
  952.     Tk_SetInternalBorder(textPtr->tkwin,
  953.         textPtr->borderWidth + textPtr->highlightWidth);
  954.     if (textPtr->setGrid) {
  955.     Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
  956.         textPtr->charWidth, fm.linespace);
  957.     } else {
  958.     Tk_UnsetGrid(textPtr->tkwin);
  959.     }
  960.  
  961.     TkTextRelayoutWindow(textPtr);
  962. }
  963.  
  964. /*
  965.  *--------------------------------------------------------------
  966.  *
  967.  * TextEventProc --
  968.  *
  969.  *    This procedure is invoked by the Tk dispatcher on
  970.  *    structure changes to a text.  For texts with 3D
  971.  *    borders, this procedure is also invoked for exposures.
  972.  *
  973.  * Results:
  974.  *    None.
  975.  *
  976.  * Side effects:
  977.  *    When the window gets deleted, internal structures get
  978.  *    cleaned up.  When it gets exposed, it is redisplayed.
  979.  *
  980.  *--------------------------------------------------------------
  981.  */
  982.  
  983. static void
  984. TextEventProc(clientData, eventPtr)
  985.     ClientData clientData;    /* Information about window. */
  986.     register XEvent *eventPtr;    /* Information about event. */
  987. {
  988.     register TkText *textPtr = (TkText *) clientData;
  989.     TkTextIndex index, index2;
  990.  
  991.     if (eventPtr->type == Expose) {
  992.     TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
  993.         eventPtr->xexpose.y, eventPtr->xexpose.width,
  994.         eventPtr->xexpose.height);
  995.     } else if (eventPtr->type == ConfigureNotify) {
  996.     if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
  997.         || (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
  998.         TkTextRelayoutWindow(textPtr);
  999.         textPtr->prevWidth = Tk_Width(textPtr->tkwin);
  1000.         textPtr->prevHeight = Tk_Height(textPtr->tkwin);
  1001.     }
  1002.     } else if (eventPtr->type == DestroyNotify) {
  1003.     if (textPtr->tkwin != NULL) {
  1004.         if (textPtr->setGrid) {
  1005.         Tk_UnsetGrid(textPtr->tkwin);
  1006.         }
  1007.         textPtr->tkwin = NULL;
  1008.         Tcl_DeleteCommandFromToken(textPtr->interp,
  1009.             textPtr->widgetCmd);
  1010.     }
  1011.     Tcl_EventuallyFree((ClientData) textPtr, DestroyText);
  1012.     } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
  1013.     if (eventPtr->xfocus.detail != NotifyInferior) {
  1014.         Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
  1015.         if (eventPtr->type == FocusIn) {
  1016.         textPtr->flags |= GOT_FOCUS | INSERT_ON;
  1017.         if (textPtr->insertOffTime != 0) {
  1018.             textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
  1019.                 textPtr->insertOnTime, TextBlinkProc,
  1020.                 (ClientData) textPtr);
  1021.         }
  1022.         } else {
  1023.         textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
  1024.         textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
  1025.         }
  1026. #ifndef ALWAYS_SHOW_SELECTION
  1027.         TkTextRedrawTag(textPtr, NULL, NULL, textPtr->selTagPtr, 1);
  1028. #endif
  1029.         TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
  1030.         TkTextIndexForwChars(&index, 1, &index2);
  1031.         TkTextChanged(textPtr, &index, &index2);
  1032.         if (textPtr->highlightWidth > 0) {
  1033.         TkTextRedrawRegion(textPtr, 0, 0, textPtr->highlightWidth,
  1034.             textPtr->highlightWidth);
  1035.         }
  1036.     }
  1037.     }
  1038. }
  1039.  
  1040. /*
  1041.  *----------------------------------------------------------------------
  1042.  *
  1043.  * TextCmdDeletedProc --
  1044.  *
  1045.  *    This procedure is invoked when a widget command is deleted.  If
  1046.  *    the widget isn't already in the process of being destroyed,
  1047.  *    this command destroys it.
  1048.  *
  1049.  * Results:
  1050.  *    None.
  1051.  *
  1052.  * Side effects:
  1053.  *    The widget is destroyed.
  1054.  *
  1055.  *----------------------------------------------------------------------
  1056.  */
  1057.  
  1058. static void
  1059. TextCmdDeletedProc(clientData)
  1060.     ClientData clientData;    /* Pointer to widget record for widget. */
  1061. {
  1062.     TkText *textPtr = (TkText *) clientData;
  1063.     Tk_Window tkwin = textPtr->tkwin;
  1064.  
  1065.     /*
  1066.      * This procedure could be invoked either because the window was
  1067.      * destroyed and the command was then deleted (in which case tkwin
  1068.      * is NULL) or because the command was deleted, and then this procedure
  1069.      * destroys the widget.
  1070.      */
  1071.  
  1072.     if (tkwin != NULL) {
  1073.     if (textPtr->setGrid) {
  1074.         Tk_UnsetGrid(textPtr->tkwin);
  1075.     }
  1076.     textPtr->tkwin = NULL;
  1077.     Tk_DestroyWindow(tkwin);
  1078.     }
  1079. }
  1080.  
  1081. /*
  1082.  *----------------------------------------------------------------------
  1083.  *
  1084.  * InsertChars --
  1085.  *
  1086.  *    This procedure implements most of the functionality of the
  1087.  *    "insert" widget command.
  1088.  *
  1089.  * Results:
  1090.  *    None.
  1091.  *
  1092.  * Side effects:
  1093.  *    The characters in "string" get added to the text just before
  1094.  *    the character indicated by "indexPtr".
  1095.  *
  1096.  *----------------------------------------------------------------------
  1097.  */
  1098.  
  1099. static void
  1100. InsertChars(textPtr, indexPtr, string)
  1101.     TkText *textPtr;        /* Overall information about text widget. */
  1102.     TkTextIndex *indexPtr;    /* Where to insert new characters.  May be
  1103.                  * modified and/or invalidated. */
  1104.     char *string;        /* Null-terminated string containing new
  1105.                  * information to add to text. */
  1106. {
  1107.     int lineIndex, resetView, offset;
  1108.     TkTextIndex newTop;
  1109.  
  1110.     /*
  1111.      * Don't allow insertions on the last (dummy) line of the text.
  1112.      */
  1113.  
  1114.     lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
  1115.     if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
  1116.     lineIndex--;
  1117.     TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
  1118.     }
  1119.  
  1120.     /*
  1121.      * Notify the display module that lines are about to change, then do
  1122.      * the insertion.  If the insertion occurs on the top line of the
  1123.      * widget (textPtr->topIndex), then we have to recompute topIndex
  1124.      * after the insertion, since the insertion could invalidate it.
  1125.      */
  1126.  
  1127.     resetView = offset = 0;
  1128.     if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
  1129.     resetView = 1;
  1130.     offset = textPtr->topIndex.charIndex;
  1131.     if (offset > indexPtr->charIndex) {
  1132.         offset += strlen(string);
  1133.     }
  1134.     }
  1135.     TkTextChanged(textPtr, indexPtr, indexPtr);
  1136.     TkBTreeInsertChars(indexPtr, string);
  1137.     if (resetView) {
  1138.     TkTextMakeIndex(textPtr->tree, lineIndex, 0, &newTop);
  1139.     TkTextIndexForwChars(&newTop, offset, &newTop);
  1140.     TkTextSetYView(textPtr, &newTop, 0);
  1141.     }
  1142.  
  1143.     /*
  1144.      * Invalidate any selection retrievals in progress.
  1145.      */
  1146.  
  1147.     textPtr->abortSelections = 1;
  1148. }
  1149.  
  1150. /*
  1151.  *----------------------------------------------------------------------
  1152.  *
  1153.  * DeleteChars --
  1154.  *
  1155.  *    This procedure implements most of the functionality of the
  1156.  *    "delete" widget command.
  1157.  *
  1158.  * Results:
  1159.  *    Returns a standard Tcl result, and leaves an error message
  1160.  *    in textPtr->interp if there is an error.
  1161.  *
  1162.  * Side effects:
  1163.  *    Characters get deleted from the text.
  1164.  *
  1165.  *----------------------------------------------------------------------
  1166.  */
  1167.  
  1168. static int
  1169. DeleteChars(textPtr, index1String, index2String)
  1170.     TkText *textPtr;        /* Overall information about text widget. */
  1171.     char *index1String;        /* String describing location of first
  1172.                  * character to delete. */
  1173.     char *index2String;        /* String describing location of last
  1174.                  * character to delete.  NULL means just
  1175.                  * delete the one character given by
  1176.                  * index1String. */
  1177. {
  1178.     int line1, line2, line, charIndex, resetView;
  1179.     TkTextIndex index1, index2;
  1180.  
  1181.     /*
  1182.      * Parse the starting and stopping indices.
  1183.      */
  1184.  
  1185.     if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1)
  1186.         != TCL_OK) {
  1187.     return TCL_ERROR;
  1188.     }
  1189.     if (index2String != NULL) {
  1190.     if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2)
  1191.         != TCL_OK) {
  1192.         return TCL_ERROR;
  1193.     }
  1194.     } else {
  1195.     index2 = index1;
  1196.     TkTextIndexForwChars(&index2, 1, &index2);
  1197.     }
  1198.  
  1199.     /*
  1200.      * Make sure there's really something to delete.
  1201.      */
  1202.  
  1203.     if (TkTextIndexCmp(&index1, &index2) >= 0) {
  1204.     return TCL_OK;
  1205.     }
  1206.  
  1207.     /*
  1208.      * The code below is ugly, but it's needed to make sure there
  1209.      * is always a dummy empty line at the end of the text.  If the
  1210.      * final newline of the file (just before the dummy line) is being
  1211.      * deleted, then back up index to just before the newline.  If
  1212.      * there is a newline just before the first character being deleted,
  1213.      * then back up the first index too, so that an even number of lines
  1214.      * gets deleted.  Furthermore, remove any tags that are present on
  1215.      * the newline that isn't going to be deleted after all (this simulates
  1216.      * deleting the newline and then adding a "clean" one back again).
  1217.      */
  1218.  
  1219.     line1 = TkBTreeLineIndex(index1.linePtr);
  1220.     line2 = TkBTreeLineIndex(index2.linePtr);
  1221.     if (line2 == TkBTreeNumLines(textPtr->tree)) {
  1222.     TkTextTag **arrayPtr;
  1223.     int arraySize, i;
  1224.     TkTextIndex oldIndex2;
  1225.  
  1226.     oldIndex2 = index2;
  1227.     TkTextIndexBackChars(&oldIndex2, 1, &index2);
  1228.     line2--;
  1229.     if ((index1.charIndex == 0) && (line1 != 0)) {
  1230.         TkTextIndexBackChars(&index1, 1, &index1);
  1231.         line1--;
  1232.     }
  1233.     arrayPtr = TkBTreeGetTags(&index2, &arraySize);
  1234.     if (arrayPtr != NULL) {
  1235.         for (i = 0; i < arraySize; i++) {
  1236.         TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
  1237.         }
  1238.         ckfree((char *) arrayPtr);
  1239.     }
  1240.     }
  1241.  
  1242.     /*
  1243.      * Tell the display what's about to happen so it can discard
  1244.      * obsolete display information, then do the deletion.  Also,
  1245.      * if the deletion involves the top line on the screen, then
  1246.      * we have to reset the view (the deletion will invalidate
  1247.      * textPtr->topIndex).  Compute what the new first character
  1248.      * will be, then do the deletion, then reset the view.
  1249.      */
  1250.  
  1251.     TkTextChanged(textPtr, &index1, &index2);
  1252.     resetView = line = charIndex = 0;
  1253.     if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
  1254.     if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
  1255.         /*
  1256.          * Deletion range straddles topIndex: use the beginning
  1257.          * of the range as the new topIndex.
  1258.          */
  1259.  
  1260.         resetView = 1;
  1261.         line = line1;
  1262.         charIndex = index1.charIndex;
  1263.     } else if (index1.linePtr == textPtr->topIndex.linePtr) {
  1264.         /*
  1265.          * Deletion range starts on top line but after topIndex.
  1266.          * Use the current topIndex as the new one.
  1267.          */
  1268.  
  1269.         resetView = 1;
  1270.         line = line1;
  1271.         charIndex = textPtr->topIndex.charIndex;
  1272.     }
  1273.     } else if (index2.linePtr == textPtr->topIndex.linePtr) {
  1274.     /*
  1275.      * Deletion range ends on top line but before topIndex.
  1276.      * Figure out what will be the new character index for
  1277.      * the character currently pointed to by topIndex.
  1278.      */
  1279.  
  1280.     resetView = 1;
  1281.     line = line2;
  1282.     charIndex = textPtr->topIndex.charIndex;
  1283.     if (index1.linePtr != index2.linePtr) {
  1284.         charIndex -= index2.charIndex;
  1285.     } else {
  1286.         charIndex -= (index2.charIndex - index1.charIndex);
  1287.     }
  1288.     }
  1289.     TkBTreeDeleteChars(&index1, &index2);
  1290.     if (resetView) {
  1291.     TkTextMakeIndex(textPtr->tree, line, charIndex, &index1);
  1292.     TkTextSetYView(textPtr, &index1, 0);
  1293.     }
  1294.  
  1295.     /*
  1296.      * Invalidate any selection retrievals in progress.
  1297.      */
  1298.  
  1299.     textPtr->abortSelections = 1;
  1300.  
  1301.     return TCL_OK;
  1302. }
  1303.  
  1304. /*
  1305.  *----------------------------------------------------------------------
  1306.  *
  1307.  * TextFetchSelection --
  1308.  *
  1309.  *    This procedure is called back by Tk when the selection is
  1310.  *    requested by someone.  It returns part or all of the selection
  1311.  *    in a buffer provided by the caller.
  1312.  *
  1313.  * Results:
  1314.  *    The return value is the number of non-NULL bytes stored
  1315.  *    at buffer.  Buffer is filled (or partially filled) with a
  1316.  *    NULL-terminated string containing part or all of the selection,
  1317.  *    as given by offset and maxBytes.
  1318.  *
  1319.  * Side effects:
  1320.  *    None.
  1321.  *
  1322.  *----------------------------------------------------------------------
  1323.  */
  1324.  
  1325. static int
  1326. TextFetchSelection(clientData, offset, buffer, maxBytes)
  1327.     ClientData clientData;        /* Information about text widget. */
  1328.     int offset;                /* Offset within selection of first
  1329.                      * character to be returned. */
  1330.     char *buffer;            /* Location in which to place
  1331.                      * selection. */
  1332.     int maxBytes;            /* Maximum number of bytes to place
  1333.                      * at buffer, not including terminating
  1334.                      * NULL character. */
  1335. {
  1336.     register TkText *textPtr = (TkText *) clientData;
  1337.     TkTextIndex eof;
  1338.     int count, chunkSize, offsetInSeg;
  1339.     TkTextSearch search;
  1340.     TkTextSegment *segPtr;
  1341.  
  1342.     if (!textPtr->exportSelection) {
  1343.     return -1;
  1344.     }
  1345.  
  1346.     /*
  1347.      * Find the beginning of the next range of selected text.  Note:  if
  1348.      * the selection is being retrieved in multiple pieces (offset != 0)
  1349.      * and some modification has been made to the text that affects the
  1350.      * selection then reject the selection request (make 'em start over
  1351.      * again).
  1352.      */
  1353.  
  1354.     if (offset == 0) {
  1355.     TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
  1356.     textPtr->abortSelections = 0;
  1357.     } else if (textPtr->abortSelections) {
  1358.     return 0;
  1359.     }
  1360.     TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
  1361.     TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
  1362.     if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
  1363.     if (!TkBTreeNextTag(&search)) {
  1364.         if (offset == 0) {
  1365.         return -1;
  1366.         } else {
  1367.         return 0;
  1368.         }
  1369.     }
  1370.     textPtr->selIndex = search.curIndex;
  1371.     }
  1372.  
  1373.     /*
  1374.      * Each iteration through the outer loop below scans one selected range.
  1375.      * Each iteration through the inner loop scans one segment in the
  1376.      * selected range.
  1377.      */
  1378.  
  1379.     count = 0;
  1380.     while (1) {
  1381.     /*
  1382.      * Find the end of the current range of selected text.
  1383.      */
  1384.  
  1385.     if (!TkBTreeNextTag(&search)) {
  1386.         panic("TextFetchSelection couldn't find end of range");
  1387.     }
  1388.  
  1389.     /*
  1390.      * Copy information from character segments into the buffer
  1391.      * until either we run out of space in the buffer or we get
  1392.      * to the end of this range of text.
  1393.      */
  1394.  
  1395.     while (1) {
  1396.         if (maxBytes == 0) {
  1397.         goto done;
  1398.         }
  1399.         segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg);
  1400.         chunkSize = segPtr->size - offsetInSeg;
  1401.         if (chunkSize > maxBytes) {
  1402.         chunkSize = maxBytes;
  1403.         }
  1404.         if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
  1405.         int leftInRange;
  1406.  
  1407.         leftInRange = search.curIndex.charIndex
  1408.             - textPtr->selIndex.charIndex;
  1409.         if (leftInRange < chunkSize) {
  1410.             chunkSize = leftInRange;
  1411.             if (chunkSize <= 0) {
  1412.             break;
  1413.             }
  1414.         }
  1415.         }
  1416.         if (segPtr->typePtr == &tkTextCharType) {
  1417.         memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars
  1418.             + offsetInSeg), (size_t) chunkSize);
  1419.         buffer += chunkSize;
  1420.         maxBytes -= chunkSize;
  1421.         count += chunkSize;
  1422.         }
  1423.         TkTextIndexForwChars(&textPtr->selIndex, chunkSize,
  1424.             &textPtr->selIndex);
  1425.     }
  1426.  
  1427.     /*
  1428.      * Find the beginning of the next range of selected text.
  1429.      */
  1430.  
  1431.     if (!TkBTreeNextTag(&search)) {
  1432.         break;
  1433.     }
  1434.     textPtr->selIndex = search.curIndex;
  1435.     }
  1436.  
  1437.     done:
  1438.     *buffer = 0;
  1439.     return count;
  1440. }
  1441.  
  1442. /*
  1443.  *----------------------------------------------------------------------
  1444.  *
  1445.  * TkTextLostSelection --
  1446.  *
  1447.  *    This procedure is called back by Tk when the selection is
  1448.  *    grabbed away from a text widget.  On Windows and Mac systems, we
  1449.  *    want to remember the selection for the next time the focus
  1450.  *    enters the window.  On Unix, just remove the "sel" tag from
  1451.  *    everything in the widget.
  1452.  *
  1453.  * Results:
  1454.  *    None.
  1455.  *
  1456.  * Side effects:
  1457.  *    The "sel" tag is cleared from the window.
  1458.  *
  1459.  *----------------------------------------------------------------------
  1460.  */
  1461.  
  1462. void
  1463. TkTextLostSelection(clientData)
  1464.     ClientData clientData;        /* Information about text widget. */
  1465. {
  1466. #ifdef ALWAYS_SHOW_SELECTION
  1467.     register TkText *textPtr = (TkText *) clientData;
  1468.     TkTextIndex start, end;
  1469.  
  1470.     if (!textPtr->exportSelection) {
  1471.     return;
  1472.     }
  1473.  
  1474.     /*
  1475.      * On Windows and Mac systems, we want to remember the selection
  1476.      * for the next time the focus enters the window.  On Unix, 
  1477.      * just remove the "sel" tag from everything in the widget.
  1478.      */
  1479.  
  1480.     TkTextMakeIndex(textPtr->tree, 0, 0, &start);
  1481.     TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
  1482.     TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1);
  1483.     TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
  1484.     textPtr->flags &= ~GOT_SELECTION;
  1485. #endif
  1486. }
  1487.  
  1488. /*
  1489.  *----------------------------------------------------------------------
  1490.  *
  1491.  * TextBlinkProc --
  1492.  *
  1493.  *    This procedure is called as a timer handler to blink the
  1494.  *    insertion cursor off and on.
  1495.  *
  1496.  * Results:
  1497.  *    None.
  1498.  *
  1499.  * Side effects:
  1500.  *    The cursor gets turned on or off, redisplay gets invoked,
  1501.  *    and this procedure reschedules itself.
  1502.  *
  1503.  *----------------------------------------------------------------------
  1504.  */
  1505.  
  1506. static void
  1507. TextBlinkProc(clientData)
  1508.     ClientData clientData;    /* Pointer to record describing text. */
  1509. {
  1510.     register TkText *textPtr = (TkText *) clientData;
  1511.     TkTextIndex index;
  1512.     int x, y, w, h;
  1513.  
  1514.     if (!(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
  1515.     return;
  1516.     }
  1517.     if (textPtr->flags & INSERT_ON) {
  1518.     textPtr->flags &= ~INSERT_ON;
  1519.     textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
  1520.         textPtr->insertOffTime, TextBlinkProc, (ClientData) textPtr);
  1521.     } else {
  1522.     textPtr->flags |= INSERT_ON;
  1523.     textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
  1524.         textPtr->insertOnTime, TextBlinkProc, (ClientData) textPtr);
  1525.     }
  1526.     TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
  1527.     TkTextCharBbox(textPtr, &index, &x, &y, &w, &h);
  1528.     TkTextRedrawRegion(textPtr, x - textPtr->insertWidth / 2, y,
  1529.         textPtr->insertWidth, h);
  1530. }
  1531.  
  1532. /*
  1533.  *----------------------------------------------------------------------
  1534.  *
  1535.  * TextSearchCmd --
  1536.  *
  1537.  *    This procedure is invoked to process the "search" widget command
  1538.  *    for text widgets.  See the user documentation for details on what
  1539.  *    it does.
  1540.  *
  1541.  * Results:
  1542.  *    A standard Tcl result.
  1543.  *
  1544.  * Side effects:
  1545.  *    See the user documentation.
  1546.  *
  1547.  *----------------------------------------------------------------------
  1548.  */
  1549.  
  1550. static int
  1551. TextSearchCmd(textPtr, interp, argc, argv)
  1552.     TkText *textPtr;        /* Information about text widget. */
  1553.     Tcl_Interp *interp;        /* Current interpreter. */
  1554.     int argc;            /* Number of arguments. */
  1555.     char **argv;        /* Argument strings. */
  1556. {
  1557.     int backwards, exact, c, i, argsLeft, noCase, leftToScan;
  1558.     size_t length;
  1559.     int numLines, startingLine, startingChar, lineNum, firstChar, lastChar;
  1560.     int code, matchLength, matchChar, passes, stopLine, searchWholeText;
  1561.     int patLength;
  1562.     char *arg, *pattern, *varName, *p, *startOfLine;
  1563.     char buffer[20];
  1564.     TkTextIndex index, stopIndex;
  1565.     Tcl_DString line, patDString;
  1566.     TkTextSegment *segPtr;
  1567.     TkTextLine *linePtr;
  1568.     Tcl_RegExp regexp = NULL;        /* Initialization needed only to
  1569.                      * prevent compiler warning. */
  1570.  
  1571.     /*
  1572.      * Parse switches and other arguments.
  1573.      */
  1574.  
  1575.     exact = 1;
  1576.     backwards = 0;
  1577.     noCase = 0;
  1578.     varName = NULL;
  1579.     for (i = 2; i < argc; i++) {
  1580.     arg = argv[i];
  1581.     if (arg[0] != '-') {
  1582.         break;
  1583.     }
  1584.     length = strlen(arg);
  1585.     if (length < 2) {
  1586.         badSwitch:
  1587.         Tcl_AppendResult(interp, "bad switch \"", arg,
  1588.             "\": must be -forward, -backward, -exact, -regexp, ",
  1589.             "-nocase, -count, or --", (char *) NULL);
  1590.         return TCL_ERROR;
  1591.     }
  1592.     c = arg[1];
  1593.     if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) {
  1594.         backwards = 1;
  1595.     } else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) {
  1596.         if (i >= (argc-1)) {
  1597.         interp->result = "no value given for \"-count\" option";
  1598.         return TCL_ERROR;
  1599.         }
  1600.         i++;
  1601.         varName = argv[i];
  1602.     } else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) {
  1603.         exact = 1;
  1604.     } else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) {
  1605.         backwards = 0;
  1606.     } else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) {
  1607.         noCase = 1;
  1608.     } else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) {
  1609.         exact = 0;
  1610.     } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) {
  1611.         i++;
  1612.         break;
  1613.     } else {
  1614.         goto badSwitch;
  1615.     }
  1616.     }
  1617.     argsLeft = argc - (i+2);
  1618.     if ((argsLeft != 0) && (argsLeft != 1)) {
  1619.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1620.         argv[0], " search ?switches? pattern index ?stopIndex?",
  1621.         (char *) NULL);
  1622.     return TCL_ERROR;
  1623.     }
  1624.     pattern = argv[i];
  1625.  
  1626.     /*
  1627.      * Convert the pattern to lower-case if we're supposed to ignore case.
  1628.      */
  1629.  
  1630.     if (noCase) {
  1631.     Tcl_DStringInit(&patDString);
  1632.     Tcl_DStringAppend(&patDString, pattern, -1);
  1633.     pattern = Tcl_DStringValue(&patDString);
  1634.     for (p = pattern; *p != 0; p++) {
  1635.         if (isupper(UCHAR(*p))) {
  1636.         *p = tolower(UCHAR(*p));
  1637.         }
  1638.     }
  1639.     }
  1640.  
  1641.     if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
  1642.     return TCL_ERROR;
  1643.     }
  1644.     numLines = TkBTreeNumLines(textPtr->tree);
  1645.     startingLine = TkBTreeLineIndex(index.linePtr);
  1646.     startingChar = index.charIndex;
  1647.     if (startingLine >= numLines) {
  1648.     if (backwards) {
  1649.         startingLine = TkBTreeNumLines(textPtr->tree) - 1;
  1650.         startingChar = TkBTreeCharsInLine(TkBTreeFindLine(textPtr->tree,
  1651.             startingLine));
  1652.     } else {
  1653.         startingLine = 0;
  1654.         startingChar = 0;
  1655.     }
  1656.     }
  1657.     if (argsLeft == 1) {
  1658.     if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
  1659.         return TCL_ERROR;
  1660.     }
  1661.     stopLine = TkBTreeLineIndex(stopIndex.linePtr);
  1662.     if (!backwards && (stopLine == numLines)) {
  1663.         stopLine = numLines-1;
  1664.     }
  1665.     searchWholeText = 0;
  1666.     } else {
  1667.     stopLine = 0;
  1668.     searchWholeText = 1;
  1669.     }
  1670.  
  1671.     /*
  1672.      * Scan through all of the lines of the text circularly, starting
  1673.      * at the given index.
  1674.      */
  1675.  
  1676.     matchLength = patLength = 0;    /* Only needed to prevent compiler
  1677.                      * warnings. */
  1678.     if (exact) {
  1679.     patLength = strlen(pattern);
  1680.     } else {
  1681.     regexp = Tcl_RegExpCompile(interp, pattern);
  1682.     if (regexp == NULL) {
  1683.         return TCL_ERROR;
  1684.     }
  1685.     }
  1686.     lineNum = startingLine;
  1687.     code = TCL_OK;
  1688.     Tcl_DStringInit(&line);
  1689.     for (passes = 0; passes < 2; ) {
  1690.     if (lineNum >= numLines) {
  1691.         /*
  1692.          * Don't search the dummy last line of the text.
  1693.          */
  1694.  
  1695.         goto nextLine;
  1696.     }
  1697.  
  1698.     /*
  1699.      * Extract the text from the line.  If we're doing regular
  1700.      * expression matching, drop the newline from the line, so
  1701.      * that "$" can be used to match the end of the line.
  1702.      */
  1703.  
  1704.     linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
  1705.     for (segPtr = linePtr->segPtr; segPtr != NULL;
  1706.         segPtr = segPtr->nextPtr) {
  1707.         if (segPtr->typePtr != &tkTextCharType) {
  1708.         continue;
  1709.         }
  1710.         Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size);
  1711.     }
  1712.     if (!exact) {
  1713.         Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1);
  1714.     }
  1715.     startOfLine = Tcl_DStringValue(&line);
  1716.  
  1717.     /*
  1718.      * If we're ignoring case, convert the line to lower case.
  1719.      */
  1720.  
  1721.     if (noCase) {
  1722.         for (p = Tcl_DStringValue(&line); *p != 0; p++) {
  1723.         if (isupper(UCHAR(*p))) {
  1724.             *p = tolower(UCHAR(*p));
  1725.         }
  1726.         }
  1727.     }
  1728.  
  1729.     /*
  1730.      * Check for matches within the current line.  If so, and if we're
  1731.      * searching backwards, repeat the search to find the last match
  1732.      * in the line.
  1733.      */
  1734.  
  1735.     matchChar = -1;
  1736.     firstChar = 0;
  1737.     lastChar = INT_MAX;
  1738.     if (lineNum == startingLine) {
  1739.         int indexInDString;
  1740.  
  1741.         /*
  1742.          * The starting line is tricky: the first time we see it
  1743.          * we check one part of the line, and the second pass through
  1744.          * we check the other part of the line.  We have to be very
  1745.          * careful here because there could be embedded windows or
  1746.          * other things that are not in the extracted line.  Rescan
  1747.          * the original line to compute the index in it of the first
  1748.          * character.
  1749.          */
  1750.  
  1751.         indexInDString = startingChar;
  1752.         for (segPtr = linePtr->segPtr, leftToScan = startingChar;
  1753.             leftToScan > 0; segPtr = segPtr->nextPtr) {
  1754.         if (segPtr->typePtr != &tkTextCharType) {
  1755.             indexInDString -= segPtr->size;
  1756.         }
  1757.         leftToScan -= segPtr->size;
  1758.         }
  1759.  
  1760.         passes++;
  1761.         if ((passes == 1) ^ backwards) {
  1762.         /*
  1763.          * Only use the last part of the line.
  1764.          */
  1765.  
  1766.         firstChar = indexInDString;
  1767.         if (firstChar >= Tcl_DStringLength(&line)) {
  1768.             goto nextLine;
  1769.         }
  1770.         } else {
  1771.         /*
  1772.          * Use only the first part of the line.
  1773.          */
  1774.  
  1775.         lastChar = indexInDString;
  1776.         }
  1777.     }
  1778.     do {
  1779.         int thisLength;
  1780.         if (exact) {
  1781.         p = strstr(startOfLine + firstChar, pattern);
  1782.         if (p == NULL) {
  1783.             break;
  1784.         }
  1785.         i = p - startOfLine;
  1786.         thisLength = patLength;
  1787.         } else {
  1788.         char *start, *end;
  1789.         int match;
  1790.  
  1791.         match = Tcl_RegExpExec(interp, regexp,
  1792.             startOfLine + firstChar, startOfLine);
  1793.         if (match < 0) {
  1794.             code = TCL_ERROR;
  1795.             goto done;
  1796.         }
  1797.         if (!match) {
  1798.             break;
  1799.         }
  1800.         Tcl_RegExpRange(regexp, 0, &start, &end);
  1801.         i = start - startOfLine;
  1802.         thisLength = end - start;
  1803.         }
  1804.         if (i >= lastChar) {
  1805.         break;
  1806.         }
  1807.         matchChar = i;
  1808.         matchLength = thisLength;
  1809.         firstChar = matchChar+1;
  1810.     } while (backwards);
  1811.  
  1812.     /*
  1813.      * If we found a match then we're done.  Make sure that
  1814.      * the match occurred before the stopping index, if one was
  1815.      * specified.
  1816.      */
  1817.  
  1818.     if (matchChar >= 0) {
  1819.         /*
  1820.          * The index information returned by the regular expression
  1821.          * parser only considers textual information:  it doesn't
  1822.          * account for embedded windows or any other non-textual info.
  1823.          * Scan through the line's segments again to adjust both
  1824.          * matchChar and matchCount.
  1825.          */
  1826.  
  1827.         for (segPtr = linePtr->segPtr, leftToScan = matchChar;
  1828.             leftToScan >= 0; segPtr = segPtr->nextPtr) {
  1829.         if (segPtr->typePtr != &tkTextCharType) {
  1830.             matchChar += segPtr->size;
  1831.             continue;
  1832.         }
  1833.         leftToScan -= segPtr->size;
  1834.         }
  1835.         for (leftToScan += matchLength; leftToScan > 0;
  1836.             segPtr = segPtr->nextPtr) {
  1837.         if (segPtr->typePtr != &tkTextCharType) {
  1838.             matchLength += segPtr->size;
  1839.             continue;
  1840.         }
  1841.         leftToScan -= segPtr->size;
  1842.         }
  1843.         TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index);
  1844.         if (!searchWholeText) {
  1845.         if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
  1846.             goto done;
  1847.         }
  1848.         if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) {
  1849.             goto done;
  1850.         }
  1851.         }
  1852.         if (varName != NULL) {
  1853.         sprintf(buffer, "%d", matchLength);
  1854.         if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
  1855.             == NULL) {
  1856.             code = TCL_ERROR;
  1857.             goto done;
  1858.         }
  1859.         }
  1860.         TkTextPrintIndex(&index, interp->result);
  1861.         goto done;
  1862.     }
  1863.  
  1864.     /*
  1865.      * Go to the next (or previous) line;
  1866.      */
  1867.  
  1868.     nextLine:
  1869.     if (backwards) {
  1870.         lineNum--;
  1871.         if (!searchWholeText) {
  1872.         if (lineNum < stopLine) {
  1873.             break;
  1874.         }
  1875.         } else if (lineNum < 0) {
  1876.         lineNum = numLines-1;
  1877.         }
  1878.     } else {
  1879.         lineNum++;
  1880.         if (!searchWholeText) {
  1881.         if (lineNum > stopLine) {
  1882.             break;
  1883.         }
  1884.         } else if (lineNum >= numLines) {
  1885.         lineNum = 0;
  1886.         }
  1887.     }
  1888.     Tcl_DStringSetLength(&line, 0);
  1889.     }
  1890.     done:
  1891.     Tcl_DStringFree(&line);
  1892.     if (noCase) {
  1893.     Tcl_DStringFree(&patDString);
  1894.     }
  1895.     return code;
  1896. }
  1897.  
  1898. /*
  1899.  *----------------------------------------------------------------------
  1900.  *
  1901.  * TkTextGetTabs --
  1902.  *
  1903.  *    Parses a string description of a set of tab stops.
  1904.  *
  1905.  * Results:
  1906.  *    The return value is a pointer to a malloc'ed structure holding
  1907.  *    parsed information about the tab stops.  If an error occurred
  1908.  *    then the return value is NULL and an error message is left in
  1909.  *    interp->result.
  1910.  *
  1911.  * Side effects:
  1912.  *    Memory is allocated for the structure that is returned.  It is
  1913.  *    up to the caller to free this structure when it is no longer
  1914.  *    needed.
  1915.  *
  1916.  *----------------------------------------------------------------------
  1917.  */
  1918.  
  1919. TkTextTabArray *
  1920. TkTextGetTabs(interp, tkwin, string)
  1921.     Tcl_Interp *interp;            /* Used for error reporting. */
  1922.     Tk_Window tkwin;            /* Window in which the tabs will be
  1923.                      * used. */
  1924.     char *string;            /* Description of the tab stops.  See
  1925.                      * the text manual entry for details. */
  1926. {
  1927.     int argc, i, count, c;
  1928.     char **argv;
  1929.     TkTextTabArray *tabArrayPtr;
  1930.     TkTextTab *tabPtr;
  1931.  
  1932.     if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
  1933.     return NULL;
  1934.     }
  1935.  
  1936.     /*
  1937.      * First find out how many entries we need to allocate in the
  1938.      * tab array.
  1939.      */
  1940.  
  1941.     count = 0;
  1942.     for (i = 0; i < argc; i++) {
  1943.     c = argv[i][0];
  1944.     if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
  1945.         count++;
  1946.     }
  1947.     }
  1948.  
  1949.     /*
  1950.      * Parse the elements of the list one at a time to fill in the
  1951.      * array.
  1952.      */
  1953.  
  1954.     tabArrayPtr = (TkTextTabArray *) ckalloc((unsigned)
  1955.         (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab)));
  1956.     tabArrayPtr->numTabs = 0;
  1957.     for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i  < argc; i++, tabPtr++) {
  1958.     if (Tk_GetPixels(interp, tkwin, argv[i], &tabPtr->location)
  1959.         != TCL_OK) {
  1960.         goto error;
  1961.     }
  1962.     tabArrayPtr->numTabs++;
  1963.  
  1964.     /*
  1965.      * See if there is an explicit alignment in the next list
  1966.      * element.  Otherwise just use "left".
  1967.      */
  1968.  
  1969.     tabPtr->alignment = LEFT;
  1970.     if ((i+1) == argc) {
  1971.         continue;
  1972.     }
  1973.     c = UCHAR(argv[i+1][0]);
  1974.     if (!isalpha(c)) {
  1975.         continue;
  1976.     }
  1977.     i += 1;
  1978.     if ((c == 'l') && (strncmp(argv[i], "left",
  1979.         strlen(argv[i])) == 0)) {
  1980.         tabPtr->alignment = LEFT;
  1981.     } else if ((c == 'r') && (strncmp(argv[i], "right",
  1982.         strlen(argv[i])) == 0)) {
  1983.         tabPtr->alignment = RIGHT;
  1984.     } else if ((c == 'c') && (strncmp(argv[i], "center",
  1985.         strlen(argv[i])) == 0)) {
  1986.         tabPtr->alignment = CENTER;
  1987.     } else if ((c == 'n') && (strncmp(argv[i],
  1988.         "numeric", strlen(argv[i])) == 0)) {
  1989.         tabPtr->alignment = NUMERIC;
  1990.     } else {
  1991.         Tcl_AppendResult(interp, "bad tab alignment \"",
  1992.             argv[i], "\": must be left, right, center, or numeric",
  1993.             (char *) NULL);
  1994.         goto error;
  1995.     }
  1996.     }
  1997.     ckfree((char *) argv);
  1998.     return tabArrayPtr;
  1999.  
  2000.     error:
  2001.     ckfree((char *) tabArrayPtr);
  2002.     ckfree((char *) argv);
  2003.     return NULL;
  2004. }
  2005.  
  2006. /*
  2007.  *----------------------------------------------------------------------
  2008.  *
  2009.  * TextDumpCmd --
  2010.  *
  2011.  *    Return information about the text, tags, marks, and embedded windows
  2012.  *    and images in a text widget.  See the man page for the description
  2013.  *    of the text dump operation for all the details.
  2014.  *
  2015.  * Results:
  2016.  *    A standard Tcl result.
  2017.  *
  2018.  * Side effects:
  2019.  *    Memory is allocated for the result, if needed (standard Tcl result
  2020.  *    side effects).
  2021.  *
  2022.  *----------------------------------------------------------------------
  2023.  */
  2024.  
  2025. static int
  2026. TextDumpCmd(textPtr, interp, argc, argv)
  2027.     register TkText *textPtr;    /* Information about text widget. */
  2028.     Tcl_Interp *interp;        /* Current interpreter. */
  2029.     int argc;            /* Number of arguments. */
  2030.     char **argv;        /* Argument strings.  Someone else has already
  2031.                  * parsed this command enough to know that
  2032.                  * argv[1] is "dump". */
  2033. {
  2034.     TkTextIndex index1, index2;
  2035.     int arg;
  2036.     int lineno;            /* Current line number */
  2037.     int what = 0;        /* bitfield to select segment types */
  2038.     int atEnd;            /* True if dumping up to logical end */
  2039.     TkTextLine *linePtr;
  2040.     char *command = NULL;    /* Script callback to apply to segments */
  2041. #define TK_DUMP_TEXT    0x1
  2042. #define TK_DUMP_MARK    0x2
  2043. #define TK_DUMP_TAG    0x4
  2044. #define TK_DUMP_WIN    0x8
  2045. #define TK_DUMP_IMG    0x10
  2046. #define TK_DUMP_ALL    (TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG| \
  2047.     TK_DUMP_WIN|TK_DUMP_IMG)
  2048.  
  2049.     for (arg=2 ; argv[arg] != (char *) NULL ; arg++) {
  2050.     size_t len;
  2051.     if (argv[arg][0] != '-') {
  2052.         break;
  2053.     }
  2054.     len = strlen(argv[arg]);
  2055.     if (strncmp("-all", argv[arg], len) == 0) {
  2056.         what = TK_DUMP_ALL;
  2057.     } else if (strncmp("-text", argv[arg], len) == 0) {
  2058.         what |= TK_DUMP_TEXT;
  2059.     } else if (strncmp("-tag", argv[arg], len) == 0) {
  2060.         what |= TK_DUMP_TAG;
  2061.     } else if (strncmp("-mark", argv[arg], len) == 0) {
  2062.         what |= TK_DUMP_MARK;
  2063.     } else if (strncmp("-image", argv[arg], len) == 0) {
  2064.         what |= TK_DUMP_IMG;
  2065.     } else if (strncmp("-window", argv[arg], len) == 0) {
  2066.         what |= TK_DUMP_WIN;
  2067.     } else if (strncmp("-command", argv[arg], len) == 0) {
  2068.         arg++;
  2069.         if (arg >= argc) {
  2070.         Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
  2071.         return TCL_ERROR;
  2072.         }
  2073.         command = argv[arg];
  2074.     } else {
  2075.         Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
  2076.         return TCL_ERROR;
  2077.     }
  2078.     }
  2079.     if (arg >= argc) {
  2080.     Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
  2081.     return TCL_ERROR;
  2082.     }
  2083.     if (what == 0) {
  2084.     what = TK_DUMP_ALL;
  2085.     }
  2086.     if (TkTextGetIndex(interp, textPtr, argv[arg], &index1) != TCL_OK) {
  2087.     return TCL_ERROR;
  2088.     }
  2089.     lineno = TkBTreeLineIndex(index1.linePtr) + 1;
  2090.     arg++;
  2091.     atEnd = 0;
  2092.     if (argc == arg) {
  2093.     TkTextIndexForwChars(&index1, 1, &index2);
  2094.     } else {
  2095.     if (TkTextGetIndex(interp, textPtr, argv[arg], &index2) != TCL_OK) {
  2096.         return TCL_ERROR;
  2097.     }
  2098.     if (strncmp(argv[arg], "end", strlen(argv[arg])) == 0) {
  2099.         atEnd = 1;
  2100.     }
  2101.     }
  2102.     if (TkTextIndexCmp(&index1, &index2) >= 0) {
  2103.     return TCL_OK;
  2104.     }
  2105.     if (index1.linePtr == index2.linePtr) {
  2106.     DumpLine(interp, textPtr, what, index1.linePtr,
  2107.         index1.charIndex, index2.charIndex, lineno, command);
  2108.     } else {
  2109.     DumpLine(interp, textPtr, what, index1.linePtr,
  2110.         index1.charIndex, 32000000, lineno, command);
  2111.     linePtr = index1.linePtr;
  2112.     while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
  2113.         lineno++;
  2114.         if (linePtr == index2.linePtr) {
  2115.         break;
  2116.         }
  2117.         DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
  2118.             lineno, command);
  2119.     }
  2120.     DumpLine(interp, textPtr, what, index2.linePtr, 0,
  2121.         index2.charIndex, lineno, command);
  2122.     }
  2123.     /*
  2124.      * Special case to get the leftovers hiding at the end mark.
  2125.      */
  2126.     if (atEnd) {
  2127.     DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
  2128.         0, 1, lineno, command);
  2129.  
  2130.     }
  2131.     return TCL_OK;
  2132. }
  2133.  
  2134. /*
  2135.  * DumpLine
  2136.  *     Return information about a given text line from character
  2137.  *    position "start" up to, but not including, "end".
  2138.  *
  2139.  * Results:
  2140.  *    A standard Tcl result.
  2141.  *
  2142.  * Side effects:
  2143.  *    None, but see DumpSegment.
  2144.  */
  2145. static void
  2146. DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
  2147.     Tcl_Interp *interp;
  2148.     TkText *textPtr;
  2149.     int what;            /* bit flags to select segment types */
  2150.     TkTextLine *linePtr;    /* The current line */
  2151.     int start, end;        /* Character range to dump */
  2152.     int lineno;            /* Line number for indices dump */
  2153.     char *command;        /* Script to apply to the segment */
  2154. {
  2155.     int offset;
  2156.     TkTextSegment *segPtr;
  2157.     /*
  2158.      * Must loop through line looking at its segments.
  2159.      * character
  2160.      * toggleOn, toggleOff
  2161.      * mark
  2162.      * image
  2163.      * window
  2164.      */
  2165.     for (offset = 0, segPtr = linePtr->segPtr ;
  2166.         (offset < end) && (segPtr != (TkTextSegment *)NULL) ;
  2167.         offset += segPtr->size, segPtr = segPtr->nextPtr) {
  2168.     if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
  2169.         (offset + segPtr->size > start)) {
  2170.         char savedChar;            /* Last char used in the seg */
  2171.         int last = segPtr->size;        /* Index of savedChar */
  2172.         int first = 0;            /* Index of first char in seg */
  2173.         if (offset + segPtr->size > end) {
  2174.         last = end - offset;
  2175.         }
  2176.         if (start > offset) {
  2177.         first = start - offset;
  2178.         }
  2179.         savedChar = segPtr->body.chars[last];
  2180.         segPtr->body.chars[last] = '\0';
  2181.         DumpSegment(interp, "text", segPtr->body.chars + first,
  2182.             command, lineno, offset + first, what);
  2183.         segPtr->body.chars[last] = savedChar;
  2184.     } else if ((offset >= start)) {
  2185.         if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
  2186.         TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
  2187.         char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
  2188.         DumpSegment(interp, "mark", name,
  2189.             command, lineno, offset, what);
  2190.         } else if ((what & TK_DUMP_TAG) &&
  2191.             (segPtr->typePtr == &tkTextToggleOnType)) {
  2192.         DumpSegment(interp, "tagon",
  2193.             segPtr->body.toggle.tagPtr->name,
  2194.             command, lineno, offset, what);
  2195.         } else if ((what & TK_DUMP_TAG) && 
  2196.             (segPtr->typePtr == &tkTextToggleOffType)) {
  2197.         DumpSegment(interp, "tagoff",
  2198.             segPtr->body.toggle.tagPtr->name,
  2199.             command, lineno, offset, what);
  2200.         } else if ((what & TK_DUMP_IMG) && 
  2201.             (segPtr->typePtr->name[0] == 'i')) {
  2202.         TkTextEmbImage *eiPtr = (TkTextEmbImage *)&segPtr->body;
  2203.         char *name = (eiPtr->name ==  NULL) ? "" : eiPtr->name;
  2204.         DumpSegment(interp, "image", name,
  2205.             command, lineno, offset, what);
  2206.         } else if ((what & TK_DUMP_WIN) && 
  2207.             (segPtr->typePtr->name[0] == 'w')) {
  2208.         TkTextEmbWindow *ewPtr = (TkTextEmbWindow *)&segPtr->body;
  2209.         char *pathname;
  2210.         if (ewPtr->tkwin == (Tk_Window) NULL) {
  2211.             pathname = "";
  2212.         } else {
  2213.             pathname = Tk_PathName(ewPtr->tkwin);
  2214.         }
  2215.         DumpSegment(interp, "window", pathname,
  2216.             command, lineno, offset, what);
  2217.         }
  2218.     }
  2219.     }
  2220. }
  2221.  
  2222. /*
  2223.  * DumpSegment
  2224.  *    Either append information about the current segment to the result,
  2225.  *    or make a script callback with that information as arguments.
  2226.  *
  2227.  * Results:
  2228.  *    None
  2229.  *
  2230.  * Side effects:
  2231.  *    Either evals the callback or appends elements to the result string.
  2232.  */
  2233. static int
  2234. DumpSegment(interp, key, value, command, lineno, offset, what)
  2235.     Tcl_Interp *interp;
  2236.     char *key;            /* Segment type key */
  2237.     char *value;        /* Segment value */
  2238.     char *command;        /* Script callback */
  2239.     int lineno;            /* Line number for indices dump */
  2240.     int offset;            /* Character position */
  2241.     int what;            /* Look for TK_DUMP_INDEX bit */
  2242. {
  2243.     char buffer[30];
  2244.     sprintf(buffer, "%d.%d", lineno, offset);
  2245.     if (command == (char *) NULL) {
  2246.     Tcl_AppendElement(interp, key);
  2247.     Tcl_AppendElement(interp, value);
  2248.     Tcl_AppendElement(interp, buffer);
  2249.     return TCL_OK;
  2250.     } else {
  2251.     char *argv[4];
  2252.     char *list;
  2253.     int result;
  2254.     argv[0] = key;
  2255.     argv[1] = value;
  2256.     argv[2] = buffer;
  2257.     argv[3] = (char *) NULL;
  2258.     list = Tcl_Merge(3, argv);
  2259.     result = Tcl_VarEval(interp, command, " ", list, (char *) NULL);
  2260.     ckfree(list);
  2261.     return result;
  2262.     }
  2263. }
  2264.  
  2265.